home *** CD-ROM | disk | FTP | other *** search
/ 64'er Special 11 / 64er_Magazin_Sonderheft_11_86-11_1986_Markt__Technik_de_Side_B.d64 / klima 64_a (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  10KB  |  365 lines
  1. 1 ifpeek(56)<>143thenpoke56,143:poke52,143:clr:load"hardcopy",8,1
  2. 2 :
  3. 10 rem ************************
  4. 12 rem * klima 64 version 2.0 *
  5. 14 rem * matthias kriesell    *
  6. 16 rem * ostpreussenstrasse 6 *
  7. 18 rem * 3057 neustadt a.r.   *
  8. 20 rem * tel.: 05032/5880     *
  9. 22 rem ************************
  10. 24 :
  11. 100 rem *** m-routinen ****************
  12. 102 in=49152:cl=49397:an=49460
  13. 104 au=49479:pr=50688:pl=50746
  14. 106 li=50761:ch=49254:fo=2159
  15. 108 :
  16. 200 rem *** initialisieren ************
  17. 202 sys49152:rem pr.i/o aktivieren
  18. 204 c1$=chr$(13):c2$=chr$(20)
  19. 206 op$="daten,l,"+chr$(38)
  20. 208 qw=255:dimqq$(qw)
  21. 210 dimt(12),n(12),r(12),mo$(12)
  22. 212 fori=1to12:readmo$(i):next
  23. 214 z$=chr$(0)
  24. 216 h4$="[197]rfa\te [207]rte ausgeben"
  25. 218 xl=174:xh=175:ya=176:z=130
  26. 220 bw$="[194]itte w@hlen [211]ie:"
  27. 222 c$(0)="                                                            "
  28. 224 c$(1)="      "
  29. 226 poke650,128
  30. 900 rem *** erste indizierung *********
  31. 902 open1,8,15:sv=0:gosub7020
  32. 904 :
  33. 1000 rem *** hauptmenu ****************
  34. 1002 gosub7000
  35. 1004 syspr,132,4,"[200]auptmenu"
  36. 1006 syspr,115,7,bw$
  37. 1008 syspr,101,9,"1) [203]limawerte eingeben"
  38. 1010 syspr,100,11,"2) [203]limadiagramm erstellen"
  39. 1012 syspr,100,13,"3) [200]ilfsprogramme"
  40. 1014 syspr,100,15,"4) [208]rogramm beenden"
  41. 1016 a=17:w$="4":gosub8050
  42. 1018 onagoto2000,3000,1200,1100
  43. 1020 :
  44. 1100 rem *** programm beenden *********
  45. 1102 gosub7000
  46. 1104 syspr,112,4,"[208]rogramm beenden"
  47. 1106 a=7:gosub8070:ifnotathen1000
  48. 1108 gosub7060
  49. 1110 close1:poke53281,0:print"[144][147]":sysau:sys64738
  50. 1112 :
  51. 1200 rem *** hilfsprogramme ***********
  52. 1202 gosub7000
  53. 1204 syspr,118,4,"[200]ilfsprogramme"
  54. 1206 syspr,115,7,bw$
  55. 1208 syspr,101,9,"1) [203]limawerte ausgeben"
  56. 1210 syspr,100,11,"2) [203]limawerte @ndern"
  57. 1212 syspr,100,13,"3) "+h4$
  58. 1214 syspr,100,15,"4) [196]atei aktualisieren"
  59. 1216 syspr,100,17,"5) [193]ndere [196]atendiskette indizieren"
  60. 1218 syspr,100,19,"6) [206]eue [196]atei anlegen"
  61. 1220 syspr,100,21,"7) [218]ur^ck zum [200]auptmenu"
  62. 1222 w$="7":a=23:gosub8050
  63. 1224 onagoto1300,1350,1400,1250,1270,1500,1000
  64. 1226 :
  65. 1250 rem *** datei aktualisieren ******
  66. 1252 gosub7000
  67. 1254 syspr,108,4,"[196]atei aktualisieren"
  68. 1256 gosub7080
  69. 1258 goto1200
  70. 1260 :
  71. 1270 rem *** andere diskette **********
  72. 1272 gosub7000
  73. 1274 syspr,92,4,"[193]ndere [196]iskette indizieren"
  74. 1276 gosub7060
  75. 1278 gosub7020
  76. 1280 goto1200
  77. 1282 :
  78. 1300 rem *** ausgabe ******************
  79. 1302 gosub7000
  80. 1304 syspr,105,4,"[203]limawerte ausgeben"
  81. 1306 gosub7130:ifd=0then1200
  82. 1308 gosub2100
  83. 1310 gosub8080:goto1200
  84. 1312 :
  85. 1350 rem *** aendern ******************
  86. 1352 gosub7000
  87. 1354 syspr,110,4,"[203]limawerte @ndern"
  88. 1356 gosub7130:ifd=0then1200
  89. 1358 gosub2100:gosub2200
  90. 1360 gosub2400:goto1200
  91. 1362 :
  92. 1400 rem *** orte ausgeben ************
  93. 1402 i=0
  94. 1404 gosub7000
  95. 1406 syspr,101,4,"[197]rfa\te [207]rte ausgeben"
  96. 1408 ifqq=0thensyspr,0,7,"[203]eine [207]rte erfa\t.":gosub8000:goto1200
  97. 1410 i=i+1:syspr,0,6+i-int((i-1)/10)*10,qq$(i):ifi=qqthen1420
  98. 1412 ifint(i/10)<>i/10then1410
  99. 1414 i=i+1:syspr,160,6+i-int((i-1)/10)*10,qq$(i):ifi=qqthen1420
  100. 1416 ifint(i/10)<>i/10then1414
  101. 1418 pokeya,20:gosub8080:goto1404
  102. 1420 pokeya,20:gosub8080:goto1200
  103. 1422 :
  104. 1500 rem *** datei anlegen ************
  105. 1501 gosub7000
  106. 1502 syspr,110,4,"[206]eue [196]atei anlegen"
  107. 1503 gosub7060
  108. 1504 gosub7000
  109. 1505 syspr,110,4,"[206]eue [196]atei anlegen"
  110. 1506 syspr,0,7,"[194]itte legen [211]ie eine formatierte [196]iskette in"
  111. 1508 syspr,0,9,"[204]aufwerk #0. [196]iese [196]iskette wird eine k^nftige"
  112. 1510 syspr,0,11,"[196]atendiskette."
  113. 1512 syspr,0,13,"[198]ertig"
  114. 1514 gosub8030:ifnotathen1200
  115. 1516 print#1,"i":gosub8010:ifa<>0thenclr:run
  116. 1518 print#1,"m-r"+chr$(250)+chr$(2)+chr$(3):get#1,a$,b$,b$
  117. 1520 a=asc(a$+z$)+256*asc(b$+z$)
  118. 1522 ifa>200then1534
  119. 1524 syspr,0,16,"[193]uf der eingelegten [196]iskette ist nicht"
  120. 1526 syspr,0,18,"mehr gen^gend [211]peicherraum vorhanden."
  121. 1528 syspr,0,20,"[193]ndere [196]iskette probieren"
  122. 1530 gosub8030:ifnotathenclr:run
  123. 1532 goto1500
  124. 1534 open2,8,2,op$
  125. 1536 print#1,"p"+chr$(2)+chr$(qw)+z$+z$
  126. 1538 input#1,a,a$,a1,a2:ifa<>0then1546
  127. 1540 syspr,0,16,"[193]uf der eingelegten [196]iskette befindet sich"
  128. 1542 syspr,0,18,"bereits eine '[203]lima 64'-[196]atei."
  129. 1544 goto1528
  130. 1546 syspr,0,16,"[194]itte warten..."
  131. 1548 print#2,chr$(255)
  132. 1550 close2:input#1,a,a$,a1,a2:clr:run
  133. 1552 :
  134. 2000 rem *** werte eingeben ***********
  135. 2002 gosub7000
  136. 2004 syspr,110,4,"[203]limawerte eingeb[138]n"
  137. 2006 ot$=""
  138. 2008 fori=1to12:t(i)=0:n(i)=0:next
  139. 2010 gosub2100:gosub2200
  140. 2012 gosub7000
  141. 2014 syspr,110,4,"[203]limawerte eingeben"
  142. 2016 syspr,0,7,ot$+" erfassen"
  143. 2018 gosub8030:ifnotathen1000
  144. 2020 qq=qq+1:d=qq:gosub2400:goto1000
  145. 2022 :
  146. 2100 rem *** formular *****************
  147. 2102 syspr,0,7,"[207]rt:"+ot$
  148. 2104 syspr,2,9,"[205]onat         [212]emp.":syspr,113,9,"[206][196]."
  149. 2106 sysli,0,69,155,69
  150. 2108 sysli,0,81,155,81
  151. 2110 sysli,0,189,155,189
  152. 2112 sysli,0,69,0,189
  153. 2114 sysli,67,69,67,189
  154. 2116 sysli,111,69,111,189
  155. 2118 sysli,155,69,155,189
  156. 2120 fori=1to12
  157. 2122 syspr,2,10+i,mo$(i)
  158. 2124 syspr,69,10+i,mid$(str$(t(i)),2)
  159. 2126 syspr,113,10+i,mid$(str$(n(i)),2)
  160. 2128 next
  161. 2130 return
  162. 2132 :
  163. 2200 rem *** eingabe/aendern **********
  164. 2202 w$=ot$:w=20:x=20:y=7:gosub7100:ot$=x$
  165. 2204 fori=1to12
  166. 2206 w$=mid$(str$(t(i)),2):w=3:x=69:y=10+i:gosub7100:t(i)=val(x$)
  167. 2208 next
  168. 2210 fori=1to12
  169. 2212 w$=mid$(str$(n(i)),2):w=3:x=113:y=10+i:gosub7100:n(i)=val(x$)
  170. 2214 next
  171. 2216 syspr,2,24,"[211]ind alle [193]ngaben korrekt"
  172. 2218 gosub8030:ifnotathen2202
  173. 2220 return
  174. 2222 :
  175. 2400 rem *** ort abspeichern **********
  176. 2402 qq$(d)=ot$:sv=0
  177. 2404 open2,8,2,op$
  178. 2406 a$="":fori=1to12
  179. 2408 a$=a$+chr$(50+t(i))+chr$(n(i)and255)+chr$(n(i)/256)
  180. 2410 next
  181. 2412 print#1,"p"+chr$(2)+chr$(d)+z$+z$
  182. 2414 print#2,a$
  183. 2416 close2
  184. 2418 return
  185. 2420 :
  186. 3000 rem *** diagramm *****************
  187. 3002 gosub7000
  188. 3004 syspr,92,4,"[203]limadiagramm erstellen"
  189. 3006 gosub7130:ifd=0then1000
  190. 3007 sysfo
  191. 3008 syspr,0,0,ot$+", [203]lima"
  192. 3014 fori=1to12:r(i)=n(i):ifn(i)>100thenr(i)=100+((n(i)-100)/10)
  193. 3016 next
  194. 3018 t(0)=(t(1)+t(12))/2
  195. 3020 r(0)=(r(1)+r(12))/2
  196. 3022 sysli,13,z-t(0)*2,18,z-t(1)*2
  197. 3024 sysli,13,z-r(0),18,z-r(1)
  198. 3026 fori=2to12
  199. 3028 sysli,8+(i-1)*10,z-t(i-1)*2,8+i*10,z-t(i)*2
  200. 3030 sysli,8+(i-1)*10,z-r(i-1),8+i*10,z-r(i)
  201. 3032 next
  202. 3034 sysli,128,z-t(12)*2,133,z-t(0)*2
  203. 3036 sysli,128,z-r(12),133,z-r(0)
  204. 3038 fori=1to12
  205. 3040 ifr(i)>t(i)*2thensysli,8+i*10,z-r(i),8+i*10,z-t(i)*2:goto3046
  206. 3042 ifint(r(i)/5)=int(t(i)*2/5)then3046
  207. 3044 forj=int(r(i)/5+.5)*5+2.5to(t(i)*2)-2.5step5:syspl,8+i*10,z-j:next
  208. 3046 next
  209. 3048 fori=2to12:r=(r(i-1)+r(i))/2:t=t(i-1)+t(i)
  210. 3050 ifr>tthensysli,3+i*10,z-r,3+i*10,z-t:goto3056
  211. 3052 ifint(r/5)=int(t/5)then3056
  212. 3054 forj=int(r/5+.5)*5+2.5tot-2.5step5:syspl,3+i*10,z-j:next
  213. 3056 next
  214. 3058 fori=1to11
  215. 3060 dr=(r(i+1)-r(i))/10
  216. 3062 forj=0to9:a=8+i*10+j
  217. 3064 if(j*dr)+r(i)>100thensysli,a,30,a,130-(int(j*dr+.5)+r(i))
  218. 3066 next:next
  219. 3068 dr=(r(1)-r(0))/10
  220. 3070 forj=5to9:a=8+j
  221. 3072 if(j*dr)+r(0)>100thensysli,a,30,a,130-(int(j*dr+.5)+r(0))
  222. 3074 next
  223. 3076 dr=(r(0)-r(12))/10
  224. 3078 forj=0to5:a=128+j
  225. 3080 if(j*dr)+r(12)>100thensysli,a,30,a,130-(int(j*dr+.5)+r(12))
  226. 3082 next
  227. 3084 :
  228. 3200 a=0:tl=50:th=-50:nl=9999:nh=0
  229. 3202 s1=0:s2=0:fori=1to12
  230. 3204 ifn(i)>2*t(i)thena=a+1
  231. 3206 ift(i)<tlthentl=t(i):t1=i
  232. 3208 ift(i)>ththenth=t(i):t2=i
  233. 3210 ifn(i)<nlthennl=n(i):n1=i
  234. 3212 ifn(i)>nhthennh=n(i):n2=i
  235. 3214 s1=s1+t(i):s2=s2+n(i)
  236. 3216 next:a=int(a*100/12)
  237. 3217 iftl<0thensysli,13,z,13,z-tl*2:fori=ztoz-tl*2step10:syspl,12,i:next
  238. 3218 syspr,170,3,"[211]tatistik"
  239. 3220 syspr,170,5,"[200]umides [203]lima:"+str$(a)+" %"
  240. 3222 syspr,170,6,"[193]rrides [203]lima:"+str$(100-a)+" %"
  241. 3224 syspr,170,7,"[212]emperaturen:"
  242. 3226 syspr,170,8,"[205]in.:"+str$(tl)+" ("+mo$(t1)+")"
  243. 3228 syspr,170,9,"[205]ax.:"+str$(th)+" ("+mo$(t2)+")"
  244. 3230 syspr,170,10,"[196]urchschnitt:"+str$(int(s1/12))
  245. 3232 syspr,170,11,"[206]iederschlag:"
  246. 3234 syspr,170,12,"[205]in.:"+str$(nl)+" mm ("+mo$(n1)+")"
  247. 3236 syspr,170,13,"[205]ax.:"+str$(nh)+" mm ("+mo$(n2)+")"
  248. 3238 syspr,170,14,"[196]urchschnitt:"+str$(int(s2/12))+" mm"
  249. 3240 syspr,170,15,"[199]esamt:"+str$(s2)+" mm"
  250. 3242 pokeya,22:gosub8080
  251. 3244 goto1000
  252. 3246 :
  253. 7000 rem *** titel ********************
  254. 7002 syscl
  255. 7004 sysli,100,8,220,8
  256. 7006 syspr,112,0,"[203]limadiagramm 64"
  257. 7008 syspr,64,2,"  [215]ritten 1986 by [205]atthias [203]riesell"
  258. 7010 return
  259. 7012 :
  260. 7020 rem *** indizieren ***************
  261. 7022 gosub7000
  262. 7024 syspr,107,4,"[196]iskette indizieren"
  263. 7026 syspr,0,7,"[194]itte legen [211]ie eine [196]ateindiskette in [204]aufwerk #0."
  264. 7028 a=9:gosub8000
  265. 7030 print#1,"i"
  266. 7032 gosub8010:ifathenreturn
  267. 7034 open2,8,2,"index,p,r"
  268. 7036 input#2,qq:ifqq>0then7050
  269. 7038 input#1,a,a$,a1,a2:close2
  270. 7040 syspr,0,12,"[193]chtung !  [197]s sind noch keine [203]limawerte auf der"
  271. 7042 syspr,0,14,"eingelegten [196]iskette abgespeichert."
  272. 7044 syspr,0,16,"[215]ollen [211]ie eine andere [196]iskette indizieren"
  273. 7046 gosub8030:ifathen7020
  274. 7048 return
  275. 7050 syspr,0,12,"[193]nzahl der bisher erfa\ten [207]rte:"+str$(qq)
  276. 7052 fori=1toqq:input#2,qq$(i):next
  277. 7054 close2:sv=1:return
  278. 7056 :
  279. 7060 rem *** test auf aktuell *********
  280. 7062 ifsvthenreturn
  281. 7064 a=peek(ya)
  282. 7066 syspr,0,a+3,"[193]chtung !  [196]ie [201]ndexdatei ist nicht mehr aktuell."
  283. 7068 syspr,0,a+5,"[211]oll sie aktualisiert werden"
  284. 7070 gosub8030:ifnotathenreturn
  285. 7072 :
  286. 7080 rem *** aktualisieren ************
  287. 7082 a=peek(ya)
  288. 7084 syspr,0,a+3,"[196]ie [196]atei wird nun aktualisiert, bitte warten [211]ie.
  289. 7086 [158]pr,0,a[170]5,"(str$iskette im (NULL)aufwerk belassen, sonst str$atenverlust !!)"
  290. 7088 [152]1,"s0:index":[132]1,a
  291. 7090 [139]qq[178]0[167][142]
  292. 7092 [159]2,8,2,"index,p,w":[152]2,qq
  293. 7094 [129]i[178]1[164]qq:[152]2,qq$(i):[130]
  294. 7096 [160]2:[142]
  295. 7098 :
  296. 7100 [143] *** eingaberoutine ***********
  297. 7102 x$[178]"":a[178]0:[158]pr,x,y,c$([171](w[179]5))
  298. 7104 [151]xl,x:[151]xh,[171](x[177]255):[151]ya,y
  299. 7106 a1[178][194](xl):a2[178][194](xh)
  300. 7108 [151]780,219:[158]ch
  301. 7110 [151]xl,a1:[151]xh,a2
  302. 7112 [161]a$:[139]a$[178]"="[167][139]a[178]0[167][139]w$[179][177]""[167]x$[178]w$:a[178][195](x$):[158]pr,x,y,x$:[142]
  303. 7114 [139]a$[178]c1$[167][139]a[177]0[167][151]780,32:[158]ch:[142]
  304. 7116 [139]a$[178]c2$[167][139]a[177]0[167]7102
  305. 7118 [139]a$[178][199](34)[176]a[178]w[167]7112
  306. 7120 [139]a$[178]"^"[176]a$[178]"\"[167]7124
  307. 7122 [139]a$[179]" "[176]a$[177]"z"[167][139]a$[179]"atn"[176]a$[177]"(NULL)"[167]7112
  308. 7124 x$[178]x$[170]a$:a[178]a[170]1:[151]780,[198](a$):[158]ch:[137]7106
  309. 7126 :
  310. 7130 [143] *** ort holen ****************
  311. 7132 [139]qq[178]0[167]d[178]0:[158]pr,0,7,"(NULL)eine (NULL)rte erfa\t.":[137]8000
  312. 7134 [158]pr,0,7,"(NULL)rt:":w$[178]"":w[178]20:x[178]20:y[178]7:[141]7100:ot$[178]x$
  313. 7136 d[178]0
  314. 7138 d[178]d[170]1:[139]d[179][178]qq[167][139]ot$[179][177]qq$(d)[167]7138
  315. 7140 [139]d[177]qq[167]d[178]0:[158]pr,0,9,"(NULL)rt nicht erfa\t.":[137]8000
  316. 7142 [159]2,8,2,op$
  317. 7144 [152]1,"p"[170][199](2)[170][199](d)[170]z$[170]z$
  318. 7146 [129]i[178]1[164]12
  319. 7148 [161]#2,a$,b$,c$:t(i)[178][198](a$[170]z$)[171]50
  320. 7150 n(i)[178][198](b$[170]z$)[170]256[172][198](c$[170]z$)
  321. 7152 [130]:[160]2:[142]
  322. 7154 :
  323. 8000 [143] *** "return" *****************
  324. 8002 [158]pr,0,[194](ya)[170]2,"str$r^cken (NULL)ie [(NULL)val(NULL)(NULL)(NULL)(NULL)]."
  325. 8004 [161]a$:[139]a$[179][177][199](13)[167]8004
  326. 8006 [142]
  327. 8008 :
  328. 8010 [143] *** fehlerkanal lesen ********
  329. 8012 [132]1,a,a$,a1,a2
  330. 8014 [139]a[178]0[176]a[178]50[167][142]
  331. 8016 b[178][194](ya)
  332. 8018 [158]pr,0,b[170]3,"str$isk-valrror #"[170][202]([196](a),2)[170]": "[170]a$
  333. 8020 a[178]b[170]5:[137]8000
  334. 8022 :
  335. 8030 [143] *** "ja/nein" ****************
  336. 8032 [158]pr,[194](xl)[170]256[172][194](xh),[194](ya)," (mid$/(NULL)) ?"
  337. 8034 [161]a$:[139]a$[179][177]"j"[175]a$[179][177]"n"[167]8034
  338. 8036 [151]780,[198](a$)[170]32:[158]ch
  339. 8038 a[178](a$[178]"j"):[142]
  340. 8040 :
  341. 8050 [143] *** wahl *********************
  342. 8052 [158]pr,115,a,"right$hre (NULL)ahl (1-"[170]w$[170]"):"
  343. 8054 [161]a$:[139]a$[179]"1"[176]a$[177]w$[167]8054
  344. 8056 [151]780,[198](a$):[158]ch
  345. 8058 a[178][197](a$) :[142]
  346. 8060 :
  347. 8070 [143] *** "sicher ?" ***************
  348. 8072 [158]pr,98,a,"(NULL)ind (NULL)ie sicher"
  349. 8074 [137]8030
  350. 8076 :
  351. 8080 [143] *** hardcopy *****************
  352. 8082 [158]pr,0,[194](ya)[170]2,"left$ardcopy erstellen"
  353. 8084 [141]8030:[139][168]a[167][142]
  354. 8086 [158]pr,0,[194](ya),c$(0)
  355. 8088 [143] ***********************
  356. 8090 [143] * ggf. hardcopyaufruf *
  357. 8092 [143] * abaendern. vgl.text *
  358. 8094 [143] ***********************
  359. 8096 [158]36864:[142]
  360. 8098 :
  361. 9000 [143] *** daten ********************
  362. 9002 [131] "mid$anuar","ascebruar","(NULL)@rz","atnpril","(NULL)ai","mid$uni","mid$uli","atnugust"
  363. 9004 [131] "(NULL)eptember","(NULL)ktober","(NULL)ovember","str$ezember"
  364. 9006 :
  365.